perm filename TEST.SAI[GEO,BGB]3 blob sn#082510 filedate 1974-01-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TEST"
C00004 00003		DPYPTR←MEMORY[LOCATION(DPYBUF)]
C00009 ENDMK
C⊗;
BEGIN "TEST"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "GEOMES.HDR" SOURCE_FILE;
	REQUIRE "SLICE" LOAD_MODULE;
	ITG B1,B2,DPYPTR;
	EXTERNAL ITG SUBR MKCUTZ(INTEGER B,N);
	EXTERNAL ITG SUBR SMOOTH(INTEGER B;REAL X);
	EXTERNAL SAFE ITG ARRAY DPYBUF [0:1];
	REAL SCALE;

SAFE PROCEDURE DPYF (INTEGER F);
BEGIN "DPYF"
	INTEGER E,E0,V,I;
	E ← E0 ← PED(F); I←0;
	V ← VCW(E0,F);AIVECT(SCALE*XWC(V),SCALE*YWC(V));
	DO BEGIN V ← VCCW(E,F); I←I+1;
	AVECT(SCALE*XWC(V),SCALE*YWC(V));
	END UNTIL E0 = (E←ECCW(E,F));
	DPYSST(CVS(I));
END "DPYF";

SAFE PROCEDURE DPYPLY (INTEGER PLY);
BEGIN "DPYPLY"
	ITG F,F0;
	DPYF(PFACE(PLY));
	F ← F0 ← SON(PLY);
	IF F0=0 THEN RETURN;
	DO DPYF(PFACE(F))
	UNTIL F0=(F←BRO(F));
END "DPYPLY";

SAFE PROCEDURE DPY (INTEGER BODY);
BEGIN "DPY"
	ITG B0,B,I;
	B ← B0 ← SON(BODY);
	IF B0=0 THEN RETURN;
	DO ⊂ DPYSET(DPYPTR);DPYPLY(B);DPYOUT(1);
	OUTSTR(CVS(I←I+1)&13&10);INCHRW;
	⊃ UNTIL B0=(B←SIS(B));
END "DPY";
	DPYPTR←MEMORY[LOCATION(DPYBUF)];
	SCALE ← 1000;
	GEONIT;
α	B1 ← IGEM("CUBE");
	B1 ← IGEM("HIP.GEM[GEM,BGB]");
	ICAM("TMP.CAM[GEM,BGB]");

	B2 ← MKCUTZ(B1,41);
	DPY(B2);

	OGEM("TMP",B2);
	WHILE TRUE DO ⊂ 
		GEODPY;
		ROTATE(B2,0,0,π/16)
	⊃;
END "TEST"; BGB 15 JANUARY 1974.